home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / calr_pak.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  1.2 KB  |  37 lines
  1. 1   '***********************************************************************
  2. 2   '* CALR-PAK: a program to reduce the size of the RBBS-PC CALLERS file. *
  3. 3   '*                                                                     *
  4. 4   '* (c)1984 by Read Gilgen     This program may be copied and used free *
  5. 5   '*    of charge provided that this notice is not changed or bypassed.  *
  6. 6   '***********************************************************************
  7. 7   '
  8. 20  CLS:LOCATE 13,36:PRINT "CALR-PAK"
  9. 22  LOCATE 15,17:PRINT "Program to Reduce Size of RBBS-PC CALLERS file"
  10. 24  LOCATE 16,29:PRINT "(c)1984 by Read Gilgen"
  11. 26  FOR PAUSE=1 TO 2000:NEXT
  12. 50  CLS:KEY OFF
  13. 100  OPEN "R",#1,"callers",64:FIELD #1, 64 AS INFO$
  14. 105  LOCATE 25,1:PRINT "SPACE to continue, <CR> to save records displayed so far.";
  15. 106  LOCATE 1,1
  16. 110  UDX=LOF(1)/64
  17. 111  RCDS = 1
  18. 115  FOR LOOP=UDX TO 1 STEP -1
  19. 120  GET #1,LOOP
  20. 130  PRINT INFO$;
  21. 140  PROC$=INPUT$(1)
  22. 145  IF PROC$=CHR$(13) THEN 500
  23. 146  RCDS = RCDS +1
  24. 150  NEXT
  25. 500  CLOSE:CLS
  26. 510  OPEN "R",#1,"callers",64:FIELD #1, 64 AS INFO$
  27. 520  OPEN "R",#2,"callers.new",64:FIELD #2, 64 AS SAVIT$
  28. 530  FOR LOOP =((UDX-RCDS)+1) TO UDX
  29. 532    GET #1, LOOP
  30. 534    IF LEFT$(INFO$,10)="          " THEN GOTO 570
  31. 535  PRINT INFO$
  32. 540    LSET SAVIT$=INFO$
  33. 550    PUT #2
  34. 570  NEXT
  35. 580  CLOSE
  36. 600   ' CALR-PAK   (c) 1984 by Read Gilgen
  37.